Casos Acumulados

Mapas

Casos

Casos / 100k hab

Nacional

Lineal

Logaritmico

Duplicación

Regional

Acumulados - Lineal

Acumulados - Logaritmico

Casos Nuevos

Mapas

Casos nuevos

Column 2

Diario y media móvil - Lineal

Media Móvil - logarítmica

Duplicación de la media móvil

Column 3

Lineal

Logaritmica

Fallecidos

Column 1

Column 1

Column 1

Fallecidos Nuevos

Diagnósticos

Diagnósticos Nuevos

---
title: "CE4 - Dashboard COVID-19"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
    source_code: embed
    social: menu
    theme: cosmo
    self_contained: FALSE 
    fig_mobile: TRUE
---



```{r libraries, message=F, warning=F}
library(flexdashboard)
library(rio)
library(tidyverse)
library(XML)
library(httr)
library(RCurl)
library(sf)
library(lubridate)
library(leaflet)
library(colorspace)
library(DT)
library(zoo)
library(slider)
library(plotly)
library(waffle)
library(extrafont)
library(plyr)
library(extrafont)
library(waffle)
library(RColorBrewer)
options(scipen=999)
```

```{r imports, message=F, warning=F, include = F, echo =F}
nac <- rio::import("https://github.com/jincio/COVID_19_PERU/blob/master/reportes_minsa.xlsx?raw=true")

deps <- rio::import("https://github.com/jincio/COVID_19_PERU/blob/master/reportes_minsa.xlsx?raw=true", sheet = 2)

pop <- read_csv("data/peru_pop_stratum.csv") %>%
  group_by(dep_adm1) %>%
  dplyr::summarise(pop = sum(N)) %>%
  dplyr::mutate(REGION = toupper(dep_adm1))


Paises_LATAM <- c("Argentina","Bolivia","Brazil","Chile","Colombia","Ecuador","Mexico","Peru","Uruguay","Venezuela")
LATAM <- read_csv ("https://covid.ourworldindata.org/data/owid-covid-data.csv") %>%
  dplyr::filter(location %in% Paises_LATAM) %>%
  dplyr::mutate( mav_new = slide_dbl(new_cases, ~mean(.x, na.rm = TRUE), .before = 6))

shp <- st_read("Limite_departamental", stringsAsFactors = F)%>% 
  st_transform(4326) %>% 
  dplyr::select(Departamento = NOMBDEP)
```

```{r global, message=F, warning=F}
c.date <- max(deps$Fecha)
y.date <- as.Date(c.date) - 1 
date <- ymd(Sys.Date())
f.date <- min(deps$Fecha)
```

```{r plotly, message=F, warning=F}

plotly_config <- function(x) {
  x %>% config(locale = "es",
               displaylogo=F,
               modeBarButtonsToRemove = c("select2d","zoom2d","lasso2d",
                                          "drawclosedpath","drawopenpath",
                                          "hoverClosestCartesian","hoverCompareCartesian",
                                          "toggleHover","toggleSpikelines"),
               responsive = T
  )
}




# %>%
#   add_segments(x = "2020-03-15", xend = "2020-03-15", 
#                y = 0, yend=roundUpNice(max(nac$pos.new)),
#                text="2020-04-08",name="Estado de Emergencia",
#                hovertemplate = paste('%{text}'),
#                legendgroup = 'group2',
#                width=2, 
#                line = list(color = "#7aa82a", 
#                            width = 3, 
#                            dash = "dot")
#   ) %>%
#   add_segments(x = "2020-03-26", xend = "2020-03-26", 
#                y = 0, yend=roundUpNice(max(nac$pos.new)),
#                text="2020-04-08",name="1ra ampliación",
#                hovertemplate = paste('%{text}'),
#                legendgroup = 'group2',
#                width=2, 
#                line = list(color = "#7aa82a", 
#                            width = 3, 
#                            dash = "dot")
#                ) %>%
#   add_segments(x = "2020-04-23", xend = "2020-04-23", 
#                y = 0, yend=roundUpNice(max(nac$pos.new)),
#                text="2020-04-08",name="3ra ampliación",
#                hovertemplate = paste('%{text}'),
#                legendgroup = 'group2',
#                width=2, 
#                line = list(color = "#7aa82a", 
#                            width = 3, 
#                            dash = "dot")
#                ) 

```

```{r maps, message=F, warning=F}
map_tiles <- function(x) {
  x %>% 
    addTiles(urlTemplate = 'http://a.basemaps.cartocdn.com/dark_all/{z}/{x}/{y}.png',
             options = providerTileOptions(minZoom = 5, maxZoom = 6))
}

map_bounds <- function(x) {
  x %>% setMaxBounds(lng1 = -90.648918,
                     lat1 = 4.991423,
                     lng2 = -59.605965,
                     lat2 = -23.920121) 
}

map_poly <-  function(x,y,z) {
  x %>%
    addPolygons(fillColor = pal.cases(log(y)),
                weight = 2,
                opacity = 1,
                color = "white",
                dashArray = "",
                fillOpacity = 0.7,
                highlight = highlightOptions(
                  weight = 5,
                  color = "#666",
                  dashArray = "",
                  fillOpacity = 0.7,
                  bringToFront = TRUE),
                label = z,
                labelOptions = labelOptions(
                  style = list("font-weight" = "normal", padding = "3px 8px"),
                  textsize = "15px",
                  direction = "auto")) 
  
}

```

```{r deps, message=F, warning=F}
## Procesamiento de los datos por región.

dep <- 
  deps %>% 
  dplyr::select(dat = Fecha,
                dep = REGION, 
                pos = Positivos_totales, 
                pos.imp = PositivosImputados_totales,
                pas =Fallecidos, 
                smp =Total_muestras
  ) %>% 
  dplyr::mutate(pas = pas %>% if_else(is.na(.), 0, .),
                dat = as.Date(dat)
  ) %>% 
  group_by(dep
  ) %>% 
  dplyr::mutate(pos.new = pos - lag(pos, n = 1),
                pos.imp.new = pos.imp - lag(pos.imp, n = 1),
                pas.new = lag(pas, n = 1),
                smp.new = lag(smp, n = 1),
                ratio.new = signif(pos.new/smp.new), digits = 3,
                days.start =as.numeric(dat-first(dat), unit="days"),
                dummy = days.start+20,
                dup.1 = exp((log(2)/1)*days.start),
                dup.2 = exp((log(2)/2)*days.start),
                dup.3 = exp((log(2)/3)*days.start),
                dup.4 = exp((log(2)/4)*days.start),
                days.end = difftime(date, dat , units = c("days")),
                mav.pos.new = slide_dbl(pos.new, ~mean(.x, na.rm = TRUE), .before = 6),
                ) %>%
  merge(pop %>% 
          select(dep = REGION, pop)
        ) %>% 
  dplyr::mutate(pos.hab = pos/pop*100000,
         smp.hab = smp/pop*100000,
         pos.new.hab = smp/pop*100000,
         mav.pos.new.hab = mav.pos.new/pop*1000000)

## Poligonos y data regional - Mapas

geom.dep <- dep %>% 
  merge(shp, by.y = 'Departamento', by.x = 'dep', all.x = T) %>%
  st_as_sf(sf_column_name = 'geometry') 

rm(shp) # No more use for shp

## Datos a nivel Nacional

nac <- dep %>%
  select(-c("dep")) %>%
  group_by(dat) %>%
  dplyr::mutate_at(vars(-c("dat","dup.1","dup.2","dup.3","dup.4")),sum, na.rm = T) %>%
  dplyr::summarize_all(list(max)) %>%
  dplyr::mutate(days.end = difftime(date, dat , units = c("days")),
                days.start = as.numeric(difftime(dat,f.date), units="days"))

dup.nac <- data.frame(dat = as.Date(seq(1,30, 1)+date)) %>%
  dplyr::mutate(days.start = as.numeric(difftime(dat,f.date), units="days"),
                dummy = days.start+20,
                dup.1 = exp((log(2)/1)*days.start),
                dup.2 = exp((log(2)/2)*days.start),
                dup.3 = exp((log(2)/3)*days.start),
                dup.4 = exp((log(2)/4)*days.start)
  ) %>%
  bind_rows(nac)

## Datos del día de hoy
c.dep <- geom.dep %>%
  dplyr::filter(dat == c.date)

## Formato Regiones Wide
dep.pos <-  dep %>%
  select(dat,dep,pos,days.end) %>%
  spread(dep, pos) %>% 
  dplyr::rename(LA_LIBERTAD = `LA LIBERTAD`,
                MADRE_DE_DIOS = `MADRE DE DIOS`,
                SAN_MARTIN = `SAN MARTIN`) 


dep.mav.pos.new<-  dep %>%
  dplyr::select(dat,dep,days.end,mav.pos.new) %>%
  spread(dep, mav.pos.new) %>% 
  dplyr::rename(LA_LIBERTAD = `LA LIBERTAD`,
                MADRE_DE_DIOS = `MADRE DE DIOS`,
                SAN_MARTIN = `SAN MARTIN`) 


dep.pos.imp.new <- dep %>%
  select(dat,dep,days.end,pos.imp.new) %>%
  spread(dep, pos.imp.new) %>% 
  dplyr::rename(LA_LIBERTAD = `LA LIBERTAD`,
                MADRE_DE_DIOS = `MADRE DE DIOS`,
                SAN_MARTIN = `SAN MARTIN`) 


```

```{r, message=F, warning=F}

vars.pmav.new <- dep %>%
  dplyr::select(dat,dep,mav.pos.new.hab) %>% 
  dplyr::filter(dat == c.date) %>% 
  dplyr::arrange(dplyr::desc(mav.pos.new.hab)) %>%
  dplyr::select(dep) %>%
  dplyr::mutate(dep = ifelse(dep=="LA LIBERTAD","LA_LIBERTAD",
                                ifelse(dep=="MADRE DE DIOS","MADRE_DE_DIOS",
                                       ifelse(dep=="SAN MARTIN","SAN_MARTIN",dep))))%>% 
  .$dep

vars.mav.new <- dep %>%
  dplyr::select(dat,dep,mav.pos.new) %>% 
  dplyr::filter(dat == c.date) %>% 
  dplyr::arrange(dplyr::desc(mav.pos.new)) %>%
  dplyr::select(dep) %>%
  dplyr::mutate(dep = ifelse(dep=="LA LIBERTAD","LA_LIBERTAD",
                                ifelse(dep=="MADRE DE DIOS","MADRE_DE_DIOS",
                                       ifelse(dep=="SAN MARTIN","SAN_MARTIN",dep))))%>% 
  .$dep
last.mav.new <- vars.mav.new[length(vars.mav.new)]


vars.pos <- dep %>%
  dplyr::select(dat,dep,pos) %>% 
  dplyr::filter(dat == c.date) %>% 
  dplyr::arrange(dplyr::desc(pos)) %>%
  dplyr::select(dep) %>%
  dplyr::mutate(dep = ifelse(dep=="LA LIBERTAD","LA_LIBERTAD",
                                ifelse(dep=="MADRE DE DIOS","MADRE_DE_DIOS",
                                       ifelse(dep=="SAN MARTIN","SAN_MARTIN",dep))))%>% 
  .$dep
last.pos <- vars.pos[length(vars.pos)]

```

Casos Acumulados {.bg}
=====================================  

Mapas {.tabset data-width=250} 
-------------------------------------

### Casos

```{r, message=F, warning=F}
palette_1 <- c("#ffffff",
               "#fff3e3",
               "#ffe8c8",
               "#ffddac",
               "#ffd291",
               "#ffc775",
               "#ffbc59",
               "#ffb139", #ffa600
               "#ec9832",
               "#d8802c",
               "#c26926",
               "#ac5320",
               "#953e1b",
               "#7d2914",
               "#65150d",
               "#4e0000")

labels.total <-  sprintf(
  "%s
Casos: %s", c.dep$dep, c.dep$pos) %>% lapply(htmltools::HTML) pal.cases <- colorNumeric( palette=palette_1, domain = log(c.dep$pos), na.color="transparent") leaflet(c.dep) %>% map_tiles() %>% map_poly (c.dep$pos,labels.total) %>% addLegend("bottomleft", pal = pal.cases, values = log(c.dep$pos), title= 'Casos', labFormat = labelFormat(transform = function(x) round(exp(x)))) %>% map_bounds () ``` ### Casos / 100k hab ```{r, message=F, warning=F} labels.pos.hab <- sprintf( "%s
Casos/100k hab: %s", c.dep$dep, round(c.dep$pos.hab)) %>% lapply(htmltools::HTML) pal.cases <- colorNumeric( palette=palette_1, domain = log(c.dep$pos.hab), na.color="transparent") leaflet(c.dep) %>% map_tiles () %>% map_poly (c.dep$pos.hab,labels.pos.hab) %>% addLegend("bottomleft", pal = pal.cases, values = log(c.dep$pos.hab), title= 'Casos', labFormat = labelFormat(transform = function(x) round(exp(x)))) %>% map_bounds ``` Nacional {.tabset data-width=300} ------------------------------------- ### Lineal ```{r function.roundup} # https://stackoverflow.com/questions/6461209/how-to-round-up-to-the-nearest-10-or-100-or-x # Rounds Up to a nice number, defined as a number divisible by those in the vector. # Some other good choices of the "nice" vector above are: 1:10, c(1,5,10), seq(1, 10, 0.1),c(1,2,4,5,6,8,10) roundUpNice <- function(x, nice=c(1,2,5,6,10)) { if(length(x) != 1) stop("'x' must be of length 1") 10^floor(log10(x)) * nice[[which(x <= 10^floor(log10(x)) * nice)[[1]]]] } # roundUpNice(max(nac$pos.new))/5 ``` ```{r, message=F, warning=F} nac %>% plot_ly()%>% add_trace(x = ~dat, y = ~pos, type = 'scatter', mode = 'lines+markers', name = 'Casos Acumulados', line = list(color = '#ffa600'), marker = list(color = '#ffa600'), text = paste(nac$days.end, "días desde hoy"), hovertemplate = ~paste('Fecha: %{x}', "
Casos Acumulados: %{y:.0f}
", '%{text}'), yaxis="y2") %>% add_trace(x = ~dat, y = ~pos.new, type = 'bar', name = 'Casos Nuevos', marker = list(color = '#006b7d'), text = paste(nac$days.end, "días desde hoy"), hovertemplate = paste('Fecha: %{x}', '
Nuevos Casos: %{y}
', '%{text}')) %>% add_segments(x = "2020-04-08", xend = "2020-04-08", y = 0, yend=roundUpNice(max(nac$pos.new)), text="2020-04-08",name="Pruebas Rápidas", hovertemplate = paste('%{text}'), legendgroup = 'group2', width=2, line = list(color = "#008f6a", width = 3, dash = "dot"))%>% layout(title = 'Casos nuevos y acumulados - Perú', titlefont=list(color="white"), xaxis = list(title = "Fecha de Reporte", color = "white"), yaxis = list(side = 'left', title = 'Casos Nuevos por día', showgrid = T, gridcolor = "#818181", zeroline = F, color = "#98cbe1", range=list(0, roundUpNice(max(nac$pos.new))), autotick=F, tick0=0, dtick=roundUpNice(max(nac$pos.new))/5), yaxis2 = list(side = 'right', overlaying = "y", title = 'Casos acumulados (lineal)', showgrid = F, zeroline = F, color = "#ffd29f", range=list(0, roundUpNice(max(nac$pos))), autotick=F, tick0=0, dtick=roundUpNice(max(nac$pos))/5), legend = list(orientation = "h", xanchor = "center", yanchor = "bottom", x = 0.5, y = -0.125, font = list(color = "white")), paper_bgcolor="black", plot_bgcolor="black", hovermode = "closest", hoverdistance = 50, dragmode="pan", margin = list(l=65, r=65, b=40, t=50), autosize=T ) %>% plotly_config ``` ### Logaritmico ```{r, message=F, warning=F} nac %>% plot_ly() %>% add_trace(x = ~dat, y = ~pos.new, type = 'bar', name = 'Casos Nuevos', marker = list(color = '#006b7d'), text = paste(nac$tm, "días desde hoy"), hovertemplate = paste('Fecha: %{x}', '
Nuevos Casos: %{y}
', '%{text}'))%>% add_trace(x = ~dat, y = ~pos, type = 'scatter', mode = 'lines+markers', name = 'Casos Acumulados', yaxis = 'y2', line = list(color = '#ffa600'), marker = list(color = '#ffa600'), text = paste(nac$tm, "días desde hoy"), hovertemplate = ~paste('Fecha: %{x}', "
Casos Acumulados: %{y:.0f}
", '%{text}')) %>% add_segments(x = "2020-04-08", xend = "2020-04-08", y = 0, yend=max(nac$pos.new), text="2020-04-08",name="Inicio de P.R's", hovertemplate = paste('%{text}'), legendgroup = 'group2', width=2, line = list(color = "#7aa82a", width = 3, dash = "dot") ) %>% layout(title = 'Casos nuevos y acumulados - Perú', titlefont=list(color="white"), xaxis = list(title = "Fecha de reporte", color ="white"), yaxis = list(side = 'left', title = 'Casos Nuevos por día (lineal)', showgrid = FALSE, zeroline = FALSE, color="white"), yaxis2 = list(side = 'right', overlaying = "y", type = "log", title = 'Casos acumulados por día (logaritmica)', showgrid = FALSE, zeroline = FALSE, tickmode = "linear", tick0 = 0, color="white"), legend = list(orientation = "h", xanchor = "center", yanchor = "bottom", x = 0.5, y = -0.125, font = list(color = "white")), paper_bgcolor="black", plot_bgcolor="black", hovermode = "closest", hoverdistance = 50, dragmode="pan", margin = list(l=65, r=65, b=40, t=50) ) %>% plotly_config ``` ### Duplicación ```{r, message=F, warning=F} plot_ly(dup.nac) %>% add_trace(x = ~days.start, y = ~pos, type = 'scatter', mode = 'lines+markers', name = 'Casos Acumulados', line = list(color = '#ffa600'), marker = list(color = '#ffa600'), hovertemplate = ~paste("
Casos Acumulados: %{y:.d0}
"), legendgroup = 'group1') %>% add_trace(x = ~days.start, y = ~dup.1, mode = 'lines', name = 'Casos se duplican en un (1) día', line = list(color = '#0e5871', dash = "dash", width=3.5), text = "Casos se duplican en un (1) día", hoverinfo = "text", legendgroup = 'group2') %>% add_trace(x = ~days.start,y = ~dup.2, mode = 'lines', name = 'Casos se duplican en dos (2) días', line = list(color = '#006b7d', dash = "dash", width=3.5), text = "Casos se duplican en dos (2) días", hoverinfo = "text", legendgroup = 'group2') %>% add_trace(x = ~days.start,y = ~dup.3, mode = 'lines', name = 'Casos se duplican en tres (3) días', line = list(color = '#007e7b', dash = "dash", width=3.5), text = "Casos se duplican en tres (3) días", hoverinfo = "text", legendgroup = 'group2') %>% add_trace(x = ~days.start,y = ~dup.4, mode = 'lines', name = 'Casos se duplican en cuatro (4) días', line = list(color = '#008f6a', dash = "dash", width=3.5), text = "Casos se duplican en tres (4) días", hoverinfo = "text", legendgroup = 'group2') %>% layout(title = 'Total de casos acumulados', titlefont=list(color="white"), xaxis = list(title = "Días desde el primer reporte", range = c(as.Date(min(f.date)),max(date+15)), color ="white"), yaxis = list(side = 'left', title = 'Total de casos acumulados', type="log", range = c(min(0), max(6)), showgrid = FALSE, zeroline = FALSE, tickmode = "linear", color ="white"), legend = list(orientation = "h", xanchor = "center", yanchor = "bottom", x = 0.5, y = -0.25, font = list(color = "white")), paper_bgcolor="black", plot_bgcolor="black", hovermode = "closest", hoverdistance = 50, dragmode="pan", margin = list(l=50, r=50, b=30, t=50) ) %>% plotly_config ``` Regional {.tabset data-width=350} ------------------------------------- ```{r, message=F, warning=F} y<- dep.pos.imp.new colnames(y) <- paste(colnames(y), "2", sep = "_") y<- y %>% select(-c("dat_2","days.end_2")) %>% cbind(dep.pos) ``` ### Acumulados - Lineal ```{r, message=F, warning=F} plots <- lapply(vars.pos, function(var) { plot_ly(y) %>% add_lines(x = ~dat, y = as.formula(paste0("~", var)), text = paste(dep.pos$days.end, "días desde hoy"), hovertemplate = paste('Fecha: %{x}', '
Media Móvil: %{y:.2f}
', '%{text}'), name = ifelse(var == last.pos,"Media Móvil",var), legendgroup = 'group1', showlegend = ifelse(var == last.pos,TRUE,FALSE), line = list(color = "#ffa600", width = 4) ) %>% add_segments(x = "2020-04-08", xend = "2020-04-08", y = 0, yend = max(dep.pos[var],na.rm = T), text="2020-04-08", name="Inicio de P.R's", hovertemplate = paste('%{text}'), legendgroup = 'group2', showlegend = ifelse(var == last.pos,TRUE,FALSE), line = list(color = "#7aa82a", width = 3, dash = "dot") )%>% add_trace(x = ~dat, y = as.formula(paste0("~", var,"_2")), type = 'bar', name = 'Casos Nuevos', marker = list(color = '#006b7d'), text = paste(dep.pos.imp.new$days.end, "días desde hoy"), hovertemplate = paste('Fecha: %{x}', '
Nuevos Casos: %{y}
', '%{text}'), showlegend = ifelse(var == last.pos,TRUE,FALSE) ) %>% layout(xaxis = list(range = c(min(dep.pos.imp.new$dat), max(dep.pos.imp.new$dat)), color = "white"), yaxis = list(color = "white"), annotations = list(text = ifelse(var=="LA_LIBERTAD","LA LIBERTAD", ifelse(var=="MADRE_DE_DIOS","MADRE DE DIOS", ifelse(var=="SAN_MARTIN","SAN MARTIN",paste0("",var,"")))), x = 0,y = 1.15, yref = "paper",xref = "paper", xanchor = "left",yanchor = "top", showarrow = FALSE, font = list(size = 16, color = "white")), paper_bgcolor="black", plot_bgcolor="black", legend = list(orientation = "h", xanchor = "center", yanchor = "bottom", x = 0.5, y = -0.125, font = list(color = "white")), showlegend =T) }) subplot(plots,nrows=5, shareX = T, titleX = F) %>% layout(title = list(text = "Total de casos confirmados - Acumulado Lineal", font = list(size = 24, color="white")), annotations = list( list(text = "Fecha de reporte", x = 0.5, y = -0.09, yref = "paper", xref = "paper", showarrow = FALSE, font = list(size = 16, color = "white")), list(text = "Total de casos confirmados", x = -0.05, y = 0.5, yref = "paper", xref = "paper", showarrow = FALSE, font = list(size = 16, color ="white"), textangle = -90)), hovermode = "closest", hoverdistance = 10, dragmode="pan", margin = list(l=75, r=0, b=65, t=60) ) %>% config(locale = "es", displaylogo=F, modeBarButtonsToRemove = c("select2d","zoom2d","lasso2d", "drawclosedpath","drawopenpath", "hoverClosestCartesian","hoverCompareCartesian", "toggleHover","toggleSpikelines") ) ``` ### Acumulados - Logaritmico ```{r, message=F, warning=F} plots <- lapply(vars.pos, function(var) { plot_ly(dep.pos) %>% add_lines(x = ~dat, y = as.formula(paste0("~", var)), text = paste(dep.pos$days.end, "días desde hoy"), hovertemplate = paste('Fecha: %{x}', '
Media Móvil: %{y:.2f}
', '%{text}'), name = ifelse(var == last.pos,"Media Móvil",var), legendgroup = 'group1', showlegend = ifelse(var == last.pos,TRUE,FALSE), line = list(color = "#ffa600", width = 4) ) %>% add_segments(x = "2020-04-08", xend = "2020-04-08", y = 0, yend = max(dep.pos[var],na.rm = T), text="2020-04-08", name="Inicio de P.R's", hovertemplate = paste('%{text}'), legendgroup = 'group2', showlegend = ifelse(var == last.pos,TRUE,FALSE), line = list(color = "#7aa82a", width = 3, dash = "dot") ) %>% layout(xaxis = list(range = c(min(dep.pos$dat), max(dep.pos$dat)), color = "white"), yaxis = list(color = "white", type = "log", tickmode = "linear"), annotations = list(text = ifelse(var=="LA_LIBERTAD","LA LIBERTAD", ifelse(var=="MADRE_DE_DIOS","MADRE DE DIOS", ifelse(var=="SAN_MARTIN","SAN MARTIN",paste0("",var,"")))), x = 0,y = 1.15, yref = "paper",xref = "paper", xanchor = "left",yanchor = "top", showarrow = FALSE, font = list(size = 16, color = "white")), paper_bgcolor="black", plot_bgcolor="black", legend = list(orientation = "h", xanchor = "center", yanchor = "bottom", x = 0.5, y = -0.125, font = list(color = "white")), showlegend =T) }) subplot(plots,nrows=5, shareX = T, titleX = F) %>% layout(title = list(text = "Total de casos confirmados - Acumulado Logarítmico", font = list(size = 24, color="white")), annotations = list( list(text = "Fecha de reporte", x = 0.5, y = -0.09, yref = "paper", xref = "paper", showarrow = FALSE, font = list(size = 16, color = "white")), list(text = "Total de casos confirmados", x = -0.05, y = 0.5, yref = "paper", xref = "paper", showarrow = FALSE, font = list(size = 16, color ="white"), textangle = -90)), hovermode = "closest", hoverdistance = 10, dragmode="pan", margin = list(l=75, r=0, b=65, t=60) ) %>% plotly_config ``` Casos Nuevos {.bg} ===================================== Mapas {.tabset data-width=250} ------------------------------------- ### Casos nuevos ```{r, message=F, warning=F} x <- c.dep %>% dplyr::mutate(pos.new = ifelse(pos.new==0,NA, pos.new)) %>% .$pos.new labels.new <- sprintf( "%s
Casos: %s", c.dep$dep, c.dep$pos.new) %>% lapply(htmltools::HTML) pal.cases <- colorNumeric( palette="RdPu", domain = log(x), na.color="transparent") leaflet(c.dep) %>% map_tiles() %>% map_poly (y=x, z=labels.new) %>% addLegend("bottomleft", pal=pal.cases, values = log(x), title= 'Casos', labFormat = labelFormat(transform = function(x) round(exp(x))))%>% map_bounds() rm(x) ``` Column 2 {.tabset data-width=300} ------------------------------------- ### Diario y media móvil - Lineal ```{r, message=F, warning=F} plot_ly(nac) %>% add_trace(x = ~dat, y = ~pos.new, type = 'scatter', mode = 'lines', name = 'Casos Nuevos por día', line = list(color = '#006b7d'), text = paste(nac$days.end, "días desde hoy"), hovertemplate = paste('Fecha: %{x}', '
Nuevos Casos: %{y}
', '%{text}'))%>% add_trace(x = ~dat, y = ~mav.pos.new, type = 'scatter', mode = 'lines+markers', name = 'Media Móvil de casos por día', line = list(color = '#ffa600'), marker = list(color = '#ffa600'), text = paste(nac$days.end, "días desde hoy"), hovertemplate = ~paste('Fecha: %{x}', "
Media móvil: %{y:.0f}
", '%{text}')) %>% add_segments(x = "2020-04-08", xend = "2020-04-08", y = 0, yend=max(nac$pos.new), text="2020-04-08",name="Inicio de P.R's", hovertemplate = paste('%{text}'), legendgroup = 'group2', width=2, line = list(color = "#7aa82a", width = 3, dash = "dot") )%>% layout(title = ' Casos nuevos por día y media móvil', titlefont=list(color="white"), xaxis = list(title = "Fecha de reporte", color="white"), yaxis = list(side = 'left', title = 'Casos nuevos por día', showgrid = FALSE, zeroline = FALSE, color = "white"), yaxis2 = list(side = 'right', overlaying = "y", title = 'Casos nuevos (lineal)', showgrid = FALSE, zeroline = FALSE, color="#ffa600", range = c(min(0), max(nac$pos.new))), legend = list(orientation = "h", xanchor = "center", yanchor = "bottom", x = 0.5, y = -0.15, font = list(color = "white")), paper_bgcolor="black", plot_bgcolor="black", hovermode = "closest", hoverdistance = 50, dragmode="pan", margin = list(l=65, r=0, b=40, t=50) ) %>% config(locale = "es", displaylogo=F, modeBarButtonsToRemove = c("select2d","zoom2d","lasso2d", "drawclosedpath","drawopenpath", "hoverClosestCartesian","hoverCompareCartesian", "toggleHover","toggleSpikelines") ) ``` ### Media Móvil - logarítmica ```{r, message=F, warning=F} plot_ly(nac) %>% add_trace(x = ~dat, y = ~mav.pos.new, type = 'scatter', mode="lines",name = 'Casos Nuevos', line = list(color = '#006b7d'), text = paste(nac$days.end, "días desde hoy"), hovertemplate = paste('Fecha: %{x}', '
Nuevos Casos: %{y}
', '%{text}'))%>% add_trace(x = ~dat, y = ~mav.pos.new, type = 'scatter', mode = 'lines+markers', name = 'Media Móvil', line = list(color = '#ffa600'), marker = list(color = '#ffa600'), text = paste(nac$days.end, "días desde hoy"), hovertemplate = ~paste('Fecha: %{x}', "
Media móvil: %{y:.0f}
", '%{text}')) %>% add_segments(x = "2020-04-08", xend = "2020-04-08", y = 0, yend=max(nac$mav.pos.new), text="2020-04-08",name="Inicio de P.R's", hovertemplate = paste('%{text}'), legendgroup = 'group2', width=2, line = list(color = "#7aa82a", width = 3, dash = "dot") )%>% layout(title = 'Media móvil (7d) y casos nuevos por día - Perú', titlefont=list(color="white"), xaxis = list(title = "Fecha de reporte", color="white"), yaxis = list(side = 'left', title = 'Casos nuevos por día', showgrid = FALSE, zeroline = FALSE, color = "white", type ="log",tickmode="linear"), yaxis2 = list(side = 'right', overlaying = "y", title = 'Media móvil de casos nuevos - 7 días (lineal)', showgrid = FALSE, zeroline = FALSE, color="#ffa600", range = c(min(0), max(nac$mav.pos.new))), legend = list(orientation = "h", xanchor = "center", yanchor = "bottom", x = 0.5, y = -0.15, font = list(color = "white")), paper_bgcolor="black", plot_bgcolor="black", hovermode = "closest", hoverdistance = 50, dragmode="pan", margin = list(l=65, r=0, b=40, t=50) ) %>% config(locale = "es", displaylogo=F, modeBarButtonsToRemove = c("select2d","zoom2d","lasso2d", "drawclosedpath","drawopenpath", "hoverClosestCartesian","hoverCompareCartesian", "toggleHover","toggleSpikelines") ) ``` ### Duplicación de la media móvil ```{r, message=F, warning=F} plot_ly(dup.nac)%>% add_trace(x = ~dat, y = ~pos, type = 'scatter', mode = 'lines+markers', name = 'Casos Acumulados', line = list(color = '#ffa600'), marker = list(color = '#ffa600'), hovertemplate = ~paste("
Casos Acumulados: %{y:.d0}
"), legendgroup = 'group1') %>% add_trace(x = ~dat, y = ~dup.1, mode = 'lines', name = 'Casos se duplican en un (1) día', line = list(color = '#0e5871', dash = "dash", width=3.5), text = "Casos se duplican en un (1) día", hoverinfo = "text", legendgroup = 'group2') %>% add_trace(x = ~dat, y = ~dup.2, mode = 'lines', name = 'Casos se duplican en dos (2) días', line = list(color = '#006b7d', dash = "dash", width=3.5), text = "Casos se duplican en dos (2) días", hoverinfo = "text", legendgroup = 'group2') %>% add_trace(x = ~dat, y = ~dup.3, mode = 'lines', name = 'Casos se duplican en tres (3) días', line = list(color = '#007e7b', dash = "dash", width=3.5), text = "Casos se duplican en tres (3) días", hoverinfo = "text", legendgroup = 'group2') %>% add_trace(x = ~dat, y = ~dup.4, mode = 'lines', name = 'Casos se duplican en cuatro (4) días', line = list(color = '#008f6a', dash = "dash", width=3.5), text = "Casos se duplican en tres (4) días", hoverinfo = "text", legendgroup = 'group2') %>% layout(title = list(text= 'Tiempo de duplicación de casos acumulados', font = list( size = 20, color="white")), xaxis = list(title = "", range = c(as.Date(min(f.date)),max(date+15)), color ="white", tickformat= "%d - %b"), yaxis = list(side = 'left', title = list(text= 'Total de casos acumulados', font = list(size = 16, color = "white")), type="log", automargin = T, range = c(min(0),max(6)), showgrid = FALSE, zeroline = FALSE, tickmode = "linear", tick0 = 0, color ="white"), legend = list(orientation = "h", yref = "paper", xref = "paper", xanchor = "right", yanchor = "bottom", x = 1, y = -0.25, font = list(color = "white"), automargin = T), annotations = list(xref='paper', yref='paper', x=0, y=-0.1, xanchor='left', yanchor='bottom', text='Días desde el primer reporte', showarrow=FALSE, font = list(size = 16, color = "white")), paper_bgcolor="black", plot_bgcolor="black", hovermode = "closest", hoverdistance = 50, dragmode="pan", margin = list(l=0, r=0, b=100, t=65) ) %>% plotly_config( ) ``` ```{r} dup.nac%>% dplyr::filter(days.end<=7 )%>% dplyr::mutate(days.start = as.numeric(difftime(dat,first(dat), units="days")), dummy = days.start+20, dup.1 = exp((log(2)/1)*days.start), dup.2 = exp((log(2)/2)*days.start), dup.3 = exp((log(2)/3)*days.start), dup.4 = exp((log(2)/4)*days.start), dup.6 = exp((log(2)/6)*days.start), dup.8 = exp((log(2)/8)*days.start), pos.sim = exp(((max(.$days.start)-min(.$days.start))/min(.$days.start))*(days.start))) %>% plot_ly()%>% add_trace(x = ~dat, y = ~pos.sim, type = 'scatter', mode = 'lines+markers', name = 'Casos Acumulados', line = list(color = '#ffa600'), marker = list(color = '#ffa600'), hovertemplate = ~paste("
Casos Acumulados: %{y:.d0}
"), legendgroup = 'group1') %>% add_trace(x = ~dat, y = ~dup.1, mode = 'lines', name = 'Casos se duplican en un (1) día', line = list(color = '#0e5871', dash = "dash", width=3.5), text = "Casos se duplican en un (1) día", hoverinfo = "text", legendgroup = 'group2') %>% add_trace(x = ~dat, y = ~dup.2, mode = 'lines', name = 'Casos se duplican en dos (2) días', line = list(color = '#006b7d', dash = "dash", width=3.5), text = "Casos se duplican en dos (2) días", hoverinfo = "text", legendgroup = 'group2') %>% add_trace(x = ~dat, y = ~dup.3, mode = 'lines', name = 'Casos se duplican en tres (3) días', line = list(color = '#007e7b', dash = "dash", width=3.5), text = "Casos se duplican en tres (3) días", hoverinfo = "text", legendgroup = 'group2') %>% add_trace(x = ~dat, y = ~dup.8, mode = 'lines', name = 'Casos se duplican en ocho (8) días', line = list(color = '#008f6a', dash = "dash", width=3.5), text = "Casos se duplican en ocho (8) días", hoverinfo = "text", legendgroup = 'group2') %>% layout(title = '', titlefont=list(color="white"), xaxis = list(title = "Últimos 7 días", range = c(as.Date(min(f.date)),max(date+15)), color ="white"), yaxis = list(side = 'left', title = '', type="log", range = c(min(0),max(3)), showgrid = FALSE, zeroline = FALSE, tickmode = "linear", tick0 = 0, color ="white"), legend = list(orientation = "h", xanchor = "center", yanchor = "bottom", x = 0.5, y = -0.25, font = list(color = "white")), paper_bgcolor="black", plot_bgcolor="black", hovermode = "closest", hoverdistance = 50, dragmode="pan", margin = list(l=50, r=50, b=30, t=50) ) %>% config(locale = "es", displaylogo=F, modeBarButtonsToRemove = c("select2d","zoom2d","lasso2d", "drawclosedpath","drawopenpath", "hoverClosestCartesian","hoverCompareCartesian", "toggleHover","toggleSpikelines") ) ``` Column 3 {.tabset data-width=350} ------------------------------------- ```{r, message=F, warning=F} y<- dep.pos.imp.new colnames(y) <- paste(colnames(y), "2", sep = "_") y<- y %>% select(-c("dat_2","days.end_2")) %>% cbind(dep.mav.pos.new) ``` ### Lineal ```{r, message=F, warning=F} plots <- lapply(vars.mav.new, function(var) { plot_ly(y) %>% add_lines(x = ~dat, y = as.formula(paste0("~", var)), text = paste(y$days.end, "días desde hoy"), hovertemplate = paste('Fecha: %{x}', '
Media Móvil: %{y:.2f}
', '%{text}'), name = ifelse(var == last.mav.new,"Media Móvil",var), legendgroup = 'group1', showlegend = ifelse(var == last.mav.new,TRUE,FALSE), line = list(color = "#ffa600", width = 4) ) %>% add_segments(x = "2020-04-08", xend = "2020-04-08", y = 0, yend = max(y[paste0(var,"_2")],na.rm = T), text="2020-04-08", name="Inicio de P.R's", hovertemplate = paste('%{text}'), legendgroup = 'group2', showlegend = ifelse(var == last.mav.new,TRUE,FALSE), line = list(color = "#7aa82a", width = 3, dash = "dot") )%>% add_trace(x = ~dat, y = as.formula(paste0("~", var,"_2")), type = 'bar', name = 'Casos Nuevos', marker = list(color = '#006b7d'), text = paste(y$days.end, "días desde hoy"), hovertemplate = paste('Fecha: %{x}', '
Nuevos Casos: %{y}
', '%{text}'), showlegend = ifelse(var == last.mav.new,TRUE,FALSE)) %>% layout(xaxis = list(range = c(min(y$dat), max(y$dat)), color = "white"), yaxis = list(color = "white"), annotations = list(text = ifelse(var=="LA_LIBERTAD","LA LIBERTAD", ifelse(var=="MADRE_DE_DIOS","MADRE DE DIOS", ifelse(var=="SAN_MARTIN","SAN MARTIN",paste0("",var,"")))), x = 0,y = 1.15, yref = "paper",xref = "paper", xanchor = "left",yanchor = "top", showarrow = FALSE, font = list(size = 16, color = "white")), paper_bgcolor="black", plot_bgcolor="black", legend = list(orientation = "h", xanchor = "center", yanchor = "bottom", x = 0.5, y = -0.125, font = list(color = "white")), showlegend =T) }) subplot(plots,nrows=5, shareX = T, titleX = F) %>% layout(title = list(text = "Media móvil (7 días) de casos nuevos", font = list(size = 24, color="white")), annotations = list( list(text = "Fecha de reporte", x = 0.5, y = -0.09, yref = "paper", xref = "paper", showarrow = FALSE, font = list(size = 16, color = "white")), list(text = "Media móvil - Número de casos", x = -0.05, y = 0.5, yref = "paper", xref = "paper", showarrow = FALSE, font = list(size = 16, color ="white"), textangle = -90)), hovermode = "closest", hoverdistance = 10, dragmode="pan", margin = list(l=75, r=0, b=65, t=60) ) %>% plotly_config() ``` ### Logaritmica ```{r, message=F, warning=F} plots <- lapply(vars.mav.new, function(var) { plot_ly(y) %>% add_lines(x = ~dat, y = as.formula(paste0("~", var)), text = paste(y$days.end, "días desde hoy"), hovertemplate = paste('Fecha: %{x}', '
Media Móvil: %{y:.2f}
', '%{text}'), name = ifelse(var == last.mav.new,"Media Móvil",var), legendgroup = 'group1', showlegend = ifelse(var == last.mav.new,TRUE,FALSE), line = list(color = "#ffa600", width = 4) ) %>% add_segments(x = "2020-04-08", xend = "2020-04-08", y = 0, yend = max(y[paste0(var,"_2")],na.rm = T), text="2020-04-08", name="Inicio de P.R's", hovertemplate = paste('%{text}'), legendgroup = 'group2', showlegend = ifelse(var == last.mav.new,TRUE,FALSE), line = list(color = "#7aa82a", width = 3, dash = "dot") )%>% add_trace(x = ~dat, y = as.formula(paste0("~", var,"_2")), type = 'bar', name = 'Casos Nuevos', marker = list(color = '#006b7d'), text = paste(y$days.end, "días desde hoy"), hovertemplate = paste('Fecha: %{x}', '
Nuevos Casos: %{y}
', '%{text}'), showlegend = ifelse(var == last.mav.new,TRUE,FALSE)) %>% layout(xaxis = list(range = c(min(y$dat), max(y$dat)), color = "white"), yaxis = list(color = "white", type="log"), annotations = list(text = ifelse(var=="LA_LIBERTAD","LA LIBERTAD", ifelse(var=="MADRE_DE_DIOS","MADRE DE DIOS", ifelse(var=="SAN_MARTIN","SAN MARTIN",paste0("",var,"")))), x = 0,y = 1.15, yref = "paper",xref = "paper", xanchor = "left",yanchor = "top", showarrow = FALSE, font = list(size = 16, color = "white")), paper_bgcolor="black", plot_bgcolor="black", legend = list(orientation = "h", xanchor = "center", yanchor = "bottom", x = 0.5, y = -0.125, font = list(color = "white")), showlegend =T) }) subplot(plots,nrows=5, shareX = T, titleX = F) %>% layout(title = list(text = "Media móvil (7 días) de casos nuevos", font = list(size = 24, color="white")), annotations = list( list(text = "Fecha de reporte", x = 0.5, y = -0.09, yref = "paper", xref = "paper", showarrow = FALSE, font = list(size = 16, color = "white")), list(text = "Media móvil - Número de casos", x = -0.05, y = 0.5, yref = "paper", xref = "paper", showarrow = FALSE, font = list(size = 16, color ="white"), textangle = -90)), hovermode = "closest", hoverdistance = 10, dragmode="pan", margin = list(l=75, r=0, b=65, t=60) ) %>% config(locale = "es", displaylogo=F, modeBarButtonsToRemove = c("select2d","zoom2d","lasso2d", "drawclosedpath","drawopenpath", "hoverClosestCartesian","hoverCompareCartesian", "toggleHover","toggleSpikelines") ) ``` Fallecidos {.bg} ===================================== Column 1 {.tabset data-width=250} ------------------------------------- Column 1 {.tabset data-width=300} ------------------------------------- Column 1 {.tabset data-width=350} ------------------------------------- Fallecidos Nuevos {.bg} ===================================== Diagnósticos {.bg} ===================================== Diagnósticos Nuevos {.bg} =====================================